home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tptc17tc.zip / PUZZLE.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-25  |  5KB  |  219 lines
  1.  
  2. (*
  3.  * Example of multi-dimensional array manipulation
  4.  *)
  5.  
  6. program Puzzle;
  7.  
  8. const
  9.   XSize = 511;                { d*d*d-1}
  10.   ClassMax = 3;
  11.   TypeMax = 12;
  12.   D = 8;
  13.  
  14. type
  15.   PieceClass = 0..ClassMax;
  16.   PieceType = 0..TypeMax;
  17.   Position = 0..XSize;
  18.  
  19. var
  20.   PieceCount : array[PieceClass] of 0..13;
  21.   Class : array[PieceType] of PieceClass;
  22.   PieceMax : array[PieceType] of Position;
  23.   Puzzle : array[Position] of Boolean;
  24.   P : array[PieceType] of array[Position] of Boolean;
  25.   P2 : array[PieceType,Position] of Boolean; {alternate form}
  26.   M, N : Position;
  27.   I, J, K : 0..13;
  28.   Kount : Integer;
  29.  
  30.   function Fit(I : PieceType; J : Position) : Boolean;
  31.   label 1;
  32.   var
  33.     K : Position;
  34.   begin
  35.     Fit := False;
  36.     for K := 0 to PieceMax[I] do
  37.       if P[I, K] then
  38.         if Puzzle[J+K] then
  39.           goto 1;
  40.     Fit := True;
  41. 1:
  42.   end;
  43.  
  44.   function Place(I : PieceType; J : Position) : Position;
  45.   label
  46.     1;
  47.   var
  48.     K : Position;
  49.   begin
  50.     for K := 0 to PieceMax[I] do
  51.       if P[I, K] then
  52.         Puzzle[J+K] := True;
  53.     PieceCount[Class[I]] := PieceCount[Class[I]]-1;
  54.     for K := J to XSize do
  55.       if not Puzzle[K] then
  56.         begin
  57.           Place := K;
  58.           goto 1;
  59.         end;
  60.     WriteLn('Puzzle filled');
  61.     Place := 0;
  62. 1:
  63.   end;
  64.  
  65.   procedure Remove(I : PieceType; J : Position);
  66.   var
  67.     K : Position;
  68.   begin
  69.     for K := 0 to PieceMax[I] do
  70.       if P[I, K] then
  71.         Puzzle[J+K] := False;
  72.     PieceCount[Class[I]] := PieceCount[Class[I]]+1;
  73.   end;
  74.  
  75.   function Trial(J : Position) : Boolean;
  76.   var
  77.     I : PieceType;
  78.     K : Position;
  79.   begin
  80.     for I := 0 to TypeMax do
  81.       if PieceCount[Class[I]] <> 0 then
  82.         if Fit(I, J) then
  83.           begin
  84.             K := Place(I, J);
  85.             if Trial(K) or (K = 0) then
  86.               begin
  87.                 {writeln( 'Piece', i + 1, ' at', k + 1);}
  88.                 Trial := True;
  89.                 exit;
  90.               end
  91.             else
  92.               Remove(I, J);
  93.           end;
  94.     Trial := False;
  95.     Kount := Kount+1;
  96.   end;
  97.  
  98. begin
  99.   WriteLn('Solving puzzle...');
  100.   for M := 0 to XSize do
  101.     Puzzle[M] := True;
  102.   for I := 1 to 5 do
  103.     for J := 1 to 5 do
  104.       for K := 1 to 5 do
  105.         Puzzle[I+D*(J+D*K)] := False;
  106.  
  107.   for I := 0 to TypeMax do
  108.     for M := 0 to XSize do
  109.       P[I, M] := False;
  110.  
  111.   for I := 0 to 3 do
  112.     for J := 0 to 1 do
  113.       for K := 0 to 0 do
  114.         P[0, I+D*(J+D*K)] := True;
  115.  
  116.   Class[0] := 0;
  117.   PieceMax[0] := 3+D*1+D*D*0;
  118.   for I := 0 to 1 do
  119.     for J := 0 to 0 do
  120.       for K := 0 to 3 do
  121.         P[1, I+D*(J+D*K)] := True;
  122.  
  123.   Class[1] := 0;
  124.   PieceMax[1] := 1+D*0+D*D*3;
  125.   for I := 0 to 0 do
  126.     for J := 0 to 3 do
  127.       for K := 0 to 1 do
  128.         P[2, I+D*(J+D*K)] := True;
  129.  
  130.   Class[2] := 0;
  131.   PieceMax[2] := 0+D*3+D*D*1;
  132.   for I := 0 to 1 do
  133.     for J := 0 to 3 do
  134.       for K := 0 to 0 do
  135.         P[3, I+D*(J+D*K)] := True;
  136.  
  137.   Class[3] := 0;
  138.   PieceMax[3] := 1+D*3+D*D*0;
  139.   for I := 0 to 3 do
  140.     for J := 0 to 0 do
  141.       for K := 0 to 1 do
  142.         P[4, I+D*(J+D*K)] := True;
  143.  
  144.   Class[4] := 0;
  145.   PieceMax[4] := 3+D*0+D*D*1;
  146.   for I := 0 to 0 do
  147.     for J := 0 to 1 do
  148.       for K := 0 to 3 do
  149.         P[5, I+D*(J+D*K)] := True;
  150.  
  151.   Class[5] := 0;
  152.   PieceMax[5] := 0+D*1+D*D*3;
  153.   for I := 0 to 2 do
  154.     for J := 0 to 0 do
  155.       for K := 0 to 0 do
  156.         P[6, I+D*(J+D*K)] := True;
  157.  
  158.   Class[6] := 1;
  159.   PieceMax[6] := 2+D*0+D*D*0;
  160.   for I := 0 to 0 do
  161.     for J := 0 to 2 do
  162.       for K := 0 to 0 do
  163.         P[7, I+D*(J+D*K)] := True;
  164.  
  165.   Class[7] := 1;
  166.   PieceMax[7] := 0+D*2+D*D*0;
  167.   for I := 0 to 0 do
  168.     for J := 0 to 0 do
  169.       for K := 0 to 2 do
  170.         P[8, I+D*(J+D*K)] := True;
  171.  
  172.   Class[8] := 1;
  173.   PieceMax[8] := 0+D*0+D*D*2;
  174.   for I := 0 to 1 do
  175.     for J := 0 to 1 do
  176.       for K := 0 to 0 do
  177.         P[9, I+D*(J+D*K)] := True;
  178.  
  179.   Class[9] := 2;
  180.   PieceMax[9] := 1+D*1+D*D*0;
  181.   for I := 0 to 1 do
  182.     for J := 0 to 0 do
  183.       for K := 0 to 1 do
  184.         P[10, I+D*(J+D*K)] := True;
  185.  
  186.   Class[10] := 2;
  187.   PieceMax[10] := 1+D*0+D*D*1;
  188.   for I := 0 to 0 do
  189.     for J := 0 to 1 do
  190.       for K := 0 to 1 do
  191.         P[11, I+D*(J+D*K)] := True;
  192.  
  193.   Class[11] := 2;
  194.   PieceMax[11] := 0+D*1+D*D*1;
  195.   for I := 0 to 1 do
  196.     for J := 0 to 1 do
  197.       for K := 0 to 1 do
  198.         P[12, I+D*(J+D*K)] := True;
  199.  
  200.   Class[12] := 3;
  201.   PieceMax[12] := 1+D*1+D*D*1;
  202.   PieceCount[0] := 13;
  203.   PieceCount[1] := 3;
  204.   PieceCount[2] := 1;
  205.   PieceCount[3] := 1;
  206.   M := 1+D*(1+D*1);
  207.   Kount := 0;
  208.  
  209.   if Fit(0, M) then
  210.     N := Place(0, M)
  211.   else
  212.     WriteLn(' error 1');
  213.  
  214.   if Trial(N) then
  215.     WriteLn(' success in ', Kount, ' trials')
  216.   else
  217.     WriteLn(' failure');
  218. end.
  219.